CICA 1993 April/CICA MS Windows - April 1993.iso/unzipped/programr/bcpp/cmmdlg/port_.pas

Pascal/Delphi Source File | 1992-09-07 | 7KB | 408 lines

{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}
{   \\\                                    }
{  -(j)-                                   }
{    /juanca «                             }
{    ~                                     }
{$D ⌐ ACASA 1989-1992, All rights reserved }
{µµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµµ}

{ an OO shell for DeviceContext, place in your tPort Object any method
that makes your life with GDI easier
}

UNIT PORT_;
{$C MOVEABLE DEMANDLOAD DISCARDABLE}
INTERFACE
   USES
     WOBJECTS,
     WINTYPES;

   CONST
     NULL = 0;

   TYPE
     TPolyPoints = array[0..MaxInt div 4] of TPoint;
     PPolyPoints = ^TPolyPoints;

     PPort = ^TPort;
     Super      = TObject;
     TPort = OBJECT (Super)
       CONSTRUCTOR
         init;
       CONSTRUCTOR
         initD(hdev:THandle);
       CONSTRUCTOR
         initGet(iwin:PWindowsObject); { get the DeviceContext from a tWindow }
       CONSTRUCTOR
         compatible(dc:PPort);

       DESTRUCTOR
         done;
           virtual;
       DESTRUCTOR
         delete;
           virtual;


       FUNCTION
         context:THandle;
           virtual;
       PROCEDURE
         set_context( newHDC:THandle);

       FUNCTION
       isPrinter :Boolean;  { always FALSE, tPrinter returns TRUE }

       FUNCTION
       cycle :Boolean;
         virtual;
                              { function to call from long painting routines,
                              it exists so when painting to a tPrinter,
                              user can interruput with the PrintAbort dlg
                              }

       FUNCTION
         select(obj :THandle):THandle;

       FUNCTION
         textOut(x, y:Integer; txt:pChar):Boolean;

       PROCEDURE
         setPixel(x, y :Integer; color :TColorRef);

       PROCEDURE
         moveTo(x, y:Integer);
       PROCEDURE
         lineTo(x, y:Integer);

       FUNCTION
         rectangle(x1, y1, x2, y2:Integer):Boolean;

       FUNCTION
         ellipse(x1, y1, x2, y2:Integer):Boolean;

       FUNCTION
         polyLine(var points :TPolyPoints; count :Word):Boolean;

       FUNCTION
         polygon(var points :TPolyPoints; count :Word):Boolean;

       PROCEDURE
         lp2dp(var points; count:Word);
       PROCEDURE
         dp2lp(var points; count:Word);

       FUNCTION
         compatibleBitmap(w, h :Integer):HBitmap;

       PROCEDURE
         save;
       PROCEDURE
         restore;

       FUNCTION
         setROP2(mode:Integer):Integer;


       FUNCTION
       mapMode :Integer;

       PROCEDURE
       setMapMode(mm :Integer);

       PROCEDURE
       textExtents(s :pChar; var width, height :Word);


     PRIVATE
       _hdc : THandle;
       _win : PWindowsObject;
     END;{OBJECT Super}




{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
IMPLEMENTATION
  USES
    WINPROCS,
    STRINGS;

  CONST
    mm_DivFactor = 1;

  PROCEDURE
  {}
  softYield;
    var
     msg :tMsg;
    begin
      peekMessage(msg, 0, 0, Word(-1), pm_NoRemove)
    end;

  CONSTRUCTOR
  TPort.
    {}
  init;
    begin
      Super.init;
      _win := nil;
      _hdc := null
    end;

  CONSTRUCTOR
  TPort.
    {}
  initD(hdev:THandle);
    begin
      Super.init;
      _win := nil;
      _hdc := hdev
    end;

  CONSTRUCTOR
  TPort.
    {}
  initGet(iwin :PWindowsObject);
    begin
      Super.init;
      _win := iwin;
      if _win <> nil then
        _hdc := getDC(_win^.hwindow)
      else
        _hdc := null
    end;

  CONSTRUCTOR
  TPort.
    {}
  compatible(dc:PPort);
    begin
      TPort.initD(createCompatibleDC(dc^.context));
    end;


  DESTRUCTOR
  TPort.
    {}
  done;
    begin
      if _win <> nil
      then
        releaseDC(_win^.hwindow, context);
      _win := nil;
      _hdc := null
    end;

  DESTRUCTOR
  TPort.
    {}
  delete;
    begin
       if _hdc <> null
       then
         deleteDC(_hdc);
      _win := nil;
      _hdc := null
    end;

  FUNCTION
  TPort.
    {}
  context:THandle;
    begin
      context := _hdc
    end;

  PROCEDURE
  TPort.
    {}
  set_context(newHDC :THandle);
    begin
      _hdc := newHDC;
      _win := nil
    end;

  FUNCTION
  tPort.
  {}
  isPrinter :Boolean;
    begin
      isPrinter := FALSE
    end;

  FUNCTION
  TPort.
    {}
  cycle:Boolean;
    begin
      cycle := TRUE;
      softYield
    end;

  {}
  {}
  FUNCTION
  TPort.
    {}
  select(obj :THandle):THandle;
    begin
      select := selectObject(context, obj)
    end;

  {}
  {}
  PROCEDURE
  TPort.
    {}
  setPixel(x, y :Integer; color :TColorRef);
    begin
      WinProcs.setPixel(context, x, y, color)
    end;

  {}
  {}
  PROCEDURE
  TPort.
    {}
  moveTo(x, y:Integer);
    begin
      WinProcs.moveTo(context, x, y)
    end;

  {}
  {}
  PROCEDURE
  TPort.
    {}
  lineTo(x, y:Integer);
    begin
      WinProcs.lineTo(context, x, y)
    end;

  FUNCTION
  TPort.
    {}
  rectangle(x1, y1, x2, y2:Integer):Boolean;
    begin
      rectangle := Word(WinProcs.rectangle(context, x1, y1, x2, y2)) <> 0
    end;

  {}
  {}
  FUNCTION
  TPort.
    {}
  ellipse(x1, y1, x2, y2:Integer):Boolean;
    begin
      ellipse := Word(WinProcs.ellipse(context, x1, y1, x2, y2)) <> 0
    end;

  FUNCTION
  TPort.
    {}
  polygon(var points :TPolyPoints; count :Word):Boolean;
    begin
      polygon := 0 <> Word(WINPROCS.polygon(context, points, count))
    end;


  FUNCTION
  TPort.
    {}
  polyLine(var points :TPolyPoints; count :Word):Boolean;
    begin
      polyLine := 0 <> Word(WINPROCS.polyLine(context, points, count))
    end;


  {}
  {}
  FUNCTION
  TPort.
    {}
  textOut(x, y:Integer; txt:pChar):Boolean;
    begin
      textOut := 0 <> Word(WinProcs.textOut(context, x, y, txt, strLen(txt)));
    end;

  PROCEDURE
  TPort.
    {}
  lp2dp(var points; count:Word);
    begin
      LPToDP(context, points, count)
    end;

  PROCEDURE
  TPort.
    {}
  dp2lp(var points; count:Word);
    begin
      DPToLP(context, points, count)
    end;

  FUNCTION
  TPort.
    {}
  compatibleBitmap(w, h :Integer):HBitmap;
    begin
      compatibleBitmap := createCompatibleBitmap(context, w, h)
    end;

  PROCEDURE
  TPort.
    {}
  save;
    begin
      saveDC(context);
    end;

  PROCEDURE
  TPort.
   {}
  restore;
    begin
      restoreDC(context, -1)
    end;


  FUNCTION
  TPort.
    {}
   setROP2(mode:Integer):Integer;
     begin
       setROP2 := WinProcs.setROP2(context, mode)
     end;


  FUNCTION
  TPort.
   {}
  mapMode :Integer;
    begin
      mapMode := getMapMode(context)
    end;

  PROCEDURE
  TPort.
   {}
  setMapMode(mm :Integer);
    begin
      WinProcs.setMapMode(context, mm)
    end;

  PROCEDURE
  TPort.
   {}
  textExtents(s :pChar; var width, height :Word);
    var
      size :Longint;
    begin
      size := getTextExtent(context, s, strLen(s));
      height := hiWord(size);
      width  := loWord(size)
    end;


END.